Hardcore Visual Basic 5.0 (2nd Edition)/Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso/Code/Goodies/CallBack/CBSCROLL.FRM

Text File | 1997-06-09 | 6KB | 186 lines

VERSION 5.00
Begin VB.Form CallbackDemo
   Caption         =   "Callback Demonstrator"
   ClientHeight    =   4824
   ClientLeft      =   1200
   ClientTop       =   1536
   ClientWidth     =   9336
   LinkTopic       =   "Form2"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4824
   ScaleWidth      =   9336
   Begin VB.TextBox txtDllName
      Appearance      =   0  'Flat
      Height          =   285
      Left            =   5640
      TabIndex        =   10
      Text            =   "comdlg32.dll"
      Top             =   240
      Width           =   2415
   End
   Begin VB.CommandButton btnEnumIcons
      Caption         =   "Enumerate Strings In Dll"
      Height          =   375
      Left            =   5640
      TabIndex        =   9
      Top             =   600
      Width           =   2295
   End
   Begin VB.ListBox lstResources
      Appearance      =   0  'Flat
      Height          =   1560
      Left            =   5640
      TabIndex        =   8
      Top             =   1200
      Width           =   2415
   End
   Begin VB.ListBox lstFonts
      Appearance      =   0  'Flat
      Height          =   1560
      Left            =   3000
      TabIndex        =   7
      Top             =   1200
      Width           =   2325
   End
   Begin VB.CommandButton btnEnumFonts
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Enumerate Fonts"
      Height          =   375
      Left            =   3000
      TabIndex        =   6
      Top             =   600
      Width           =   2085
   End
   Begin VB.CommandButton btnGetTaskWindows
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Get Task Windows"
      Height          =   435
      Left            =   180
      TabIndex        =   5
      Top             =   1740
      Width           =   2265
   End
   Begin VB.ListBox lstWindows
      Appearance      =   0  'Flat
      Height          =   1944
      Left            =   210
      TabIndex        =   3
      Top             =   2250
      Width           =   2265
   End
   Begin VB.CommandButton btnEnumVisibleWindows
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Get All Visible Windows"
      Height          =   435
      Left            =   150
      TabIndex        =   2
      Top             =   1230
      Width           =   2265
   End
   Begin VB.CommandButton btnScrollBarsOff
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "ScrollBars Off"
      Height          =   465
      Left            =   120
      TabIndex        =   1
      Top             =   690
      Width           =   2385
   End
   Begin VB.CommandButton btnScrollBarsOn
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "ScrollBars On"
      Height          =   465
      Left            =   120
      TabIndex        =   0
      Top             =   150
      Width           =   2415
   End
   Begin VB.Label lblHWND
      Caption         =   "HWND = "
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Top             =   4320
      UseMnemonic     =   0   'False
      Width           =   2265
   End
End
Attribute VB_Name = "CallbackDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private ScrollCB As New ScrollBarDriver

Private Sub btnEnumFonts_Click()
Dim Enumerator As New FontEnumerator
    lstFonts.Clear
    EnumFontFamilies hdc, vbNullString, Enumerator.ProcAddress, lstFonts
End Sub

Private Sub btnEnumIcons_Click()
Dim Enumerator As New ResourceEnumerator
    Enumerator.FillListWithStringIds txtDllName, lstResources
End Sub

Private Sub btnEnumVisibleWindows_Click()
Dim Enumerator As New WindowEnumerator
    lstWindows.Clear
    EnumWindows Enumerator.ProcAddress, lstWindows
End Sub

Private Sub btnGetTaskWindows_Click()
Dim Enumerator As New WindowEnumerator
    lstWindows.Clear
    Enumerator.Recurse = False
    EnumThreadWindows GetCurrentThreadId, Enumerator.ProcAddress, lstWindows
End Sub

Private Sub btnScrollBarsOff_Click()
Dim lCurrent As Long
    lCurrent = GetWindowLong(hWnd, GWL_STYLE)
    lCurrent = Not (lCurrent Imp (WS_HSCROLL Or WS_VSCROLL))
    SetWindowLong hWnd, GWL_STYLE, lCurrent
    SetWindowPos hWnd, 0, 0, 0, 0, 0, SWP_DRAWFRAME Or SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
    ScrollCB.UnsubClass
End Sub

Private Sub btnScrollBarsOn_Click()
Dim lCurrent As Long
Dim sbMax As Long, sbMin As Long
    lCurrent = GetWindowLong(hWnd, GWL_STYLE)
    lCurrent = lCurrent Or WS_HSCROLL Or WS_VSCROLL
    SetWindowLong hWnd, GWL_STYLE, lCurrent
    SetWindowPos hWnd, 0, 0, 0, 0, 0, SWP_DRAWFRAME Or SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
    ScrollCB.SubClass hWnd
End Sub

Private Sub Form_Load()
    'To SubClass in Win16, be sure the form is already
    'visible before turning on subclassing.  Otherwise, if any
    'controls have Appearance set to 3d, there are nasty interactions
    'with Ctl3dv2.dll, which is also subclassing.
    btnScrollBarsOn_Click
    With ScrollCB
        .VScroll.Max = 100
        .HScroll.Max = 100
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    btnScrollBarsOff_Click
End Sub

Private Sub lstWindows_Click()
    With lstWindows
        lblHWND = "HWND = &H" & Hex$(.ItemData(.ListIndex))
    End With
End Sub